home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / Tickle-4.0 (tcl) / tcl / src / tclTHINKShell.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-11-08  |  3.5 KB  |  170 lines  |  [TEXT/KAHL]
  1. /* 
  2.  * tclTest.c --
  3.  *
  4.  *    Test driver for TCL.
  5.  *
  6.  * Copyright 1987-1991 Regents of the University of California
  7.  * All rights reserved.
  8.  *
  9.  * Permission to use, copy, modify, and distribute this
  10.  * software and its documentation for any purpose and without
  11.  * fee is hereby granted, provided that the above copyright
  12.  * notice appears in all copies.  The University of California
  13.  * makes no representations about the suitability of this
  14.  * software for any purpose.  It is provided "as is" without
  15.  * express or implied warranty.
  16.  */
  17.  
  18. #ifndef lint
  19. static char rcsid[] = "$Header: /user6/ouster/tcl/tclTest/RCS/tclTest.c,v 1.19 91/11/17 14:07:21 ouster Exp $ SPRITE (Berkeley)";
  20. #endif
  21.  
  22. #include <resources.h>
  23. #include <events.h>
  24. #include <files.h>
  25. #include <stdio.h>
  26. #include <stdlib.h>
  27. #include <errno.h>
  28. #include <string.h>
  29. #include <stdarg.h>
  30. #include "tcl.h"
  31. #include "tclExtend.h"
  32.  
  33. char dumpFile[100];
  34. int quitFlag = 0;
  35.  
  36. char *initCmd =
  37.     "if [file exists [info library]:init.tcl] {source [info library]:init.tcl}";
  38.  
  39. /*
  40.  * The following variable is a special hack that allows applications
  41.  * to be linked using the procedure "main" from the Tcl library.  The
  42.  * variable generates a reference to "main", which causes main to
  43.  * be brought in from the library (and all of Tcl with it).
  44.  */
  45.  
  46. extern int main();
  47. int *tclDummyMainPtr = (int *) main;
  48.  
  49.  
  50. Tcl_AppInit(interp)
  51.     Tcl_Interp    *interp;
  52.     {
  53.     short        app_refnum;
  54.     short        app_vrefnum;
  55.     Str32        volname;
  56.     
  57.     /* Get application's open resource fork reference number. */
  58.     app_refnum = CurResFile();
  59.     
  60.     /* Get working directory/volume reference number of application. */
  61.     GetVol(volname, &app_vrefnum);
  62.  
  63.     TclMac_CWDInitialize();
  64.     TclMac_InitializeOnce(app_refnum);
  65.  
  66.     Tcl_InitExtended(interp);
  67.     
  68.     Tcl_AddMacintoshCmds(interp);
  69.     Tcl_InitMacintosh(interp);
  70.  
  71.     /*
  72.     ** The following variable is necessary since the damned
  73.     ** ThinkC console behaves so strangely. See help.tcl for
  74.     ** an example of its use.
  75.     */
  76.     Tcl_SetVar(interp, "THINK_CONSOLE", "1", TCL_GLOBAL_ONLY);
  77.     
  78.     if (Tcl_Init(interp) == TCL_ERROR)
  79.         {
  80.         fprintf(stderr, "ERROR in Tcl_Init() --\n");
  81.         fprintf(stderr, "      %s\n",
  82.                     (interp->result==NULL ? "" : interp->result) );
  83.         }
  84.  
  85.     if (Tcl_ShellEnvInit( interp, TCLSH_INTERACTIVE ) != TCL_OK)
  86.         {
  87.         fprintf(stderr, "ERROR in Tcl_ShellEnvInit() --\n");
  88.         fprintf(stderr, "      %s\n",
  89.                     (interp->result==NULL ? "" : interp->result) );
  90.         }
  91.  
  92.        tcl_RcFileName = "tclshrc";
  93.     
  94.     return TCL_OK;
  95.     }
  96.  
  97. void
  98. Feedback(char *format, ...)
  99.     {
  100.     va_list        varg;
  101.     
  102.     va_start(varg, format);
  103.     
  104.     vfprintf(stderr, format, varg);
  105.     
  106.     va_end(varg);
  107.  
  108.     fprintf(stderr, "\n");
  109.     }
  110.  
  111. int
  112. mac_printf( char *format_str, ... )
  113.     {
  114.     int            result;
  115.     va_list        varg;
  116.     
  117.     va_start(varg, format_str);
  118.     
  119.     result = vprintf(format_str, varg);
  120.     
  121.     va_end(varg);
  122.     
  123.     return result;
  124.     }
  125.  
  126. int
  127. mac_fprintf( FILE *fp, char *format_str, ... )
  128.     {
  129.     int            result;
  130.     va_list        varg;
  131.     
  132.     va_start(varg, format_str);
  133.     
  134.     result = vfprintf(fp, format_str, varg);
  135.     
  136.     va_end(varg);
  137.     
  138.     return result;
  139.     }
  140.  
  141. RotateCursor(phase)
  142.     long    phase;
  143.     {
  144.     }
  145.  
  146. /*
  147. ** This is called by tcl when an environment variable
  148. ** is set, giving you the change to keep your code
  149. ** variables in sync with the $env() tcl variables.
  150. **
  151. ** When the tcl code "set env(name) value" is executed
  152. ** this call is made as:
  153. **    "check_environment_set_of_globals(name, value)".
  154. */
  155. check_environment_set_of_globals(name, value)
  156.     char    *name;
  157.     char    *value;
  158.     {
  159. #pragma unused (name, value)
  160.     }
  161.  
  162. CheckCmdPeriod()
  163.     {
  164.     KeyMap    mykeys;
  165.  
  166.     GetKeys(mykeys);
  167.     return (mykeys[1] == 0x00808000);
  168.     }
  169.  
  170.